perm filename MOVE.FAI[NEW,LCS]16 blob
sn#509267 filedate 1980-05-09 generic text, type T, neo UTF8
TITLE MOVE
ENTRY GETPTS,MOVIT,COPYIT,STFCH,DELETE
; ENTRY SLEND,POSIT,NOTAIL
EXTERNAL LOOP,RTLINE,DL,DPY,DPYNEW,.COMM.,XRN,KJY,PTR,POSI
EXTERNAL SCM,AMOD,RMOD,RINP,DPTR,LIMIT,OUTLIM
K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
; SUBROUTINE GETPTS
; DIMENSION N(500),NP(500)
; COMMON/XRN/RN(4000) /KJY/ K,J
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
; 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
; 1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
GETPTS: 0 ;CALL GETPTS(N)
SETZ J, ; J=0
SETZ K, ; K=0
MOVE JJ2,POSI+=8
MOVE R2,.COMM.
MOVE X,@(16)
SOS X
MOVEI M,PTR ; DO 1 M=1,ITEM
ADDI M,(X)
G1: AOJ X,
MOVE L,(M)
MOVEI R,XRN(L) ;L=PWDS(M)
MOVE 1,1(R) ;RN(L+2)
CAML R2,[=8.0] ;IF R2.GE.8 LOOK AT ALL STAVES
JRST GZ
CAME R2,1
JRST GX
GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
CAME A,(R)
JRST GX
; CHECK CODE NUM
G9: MOVE A,2(R) ;IF(R6.NE.RY)GO TO 1
CAMG A,.COMM.+6 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
CAMGE A,.COMM.+5 ;R4
JRST G2
CAMLE JJ2,X
MOVE JJ2,X ;IF(M.LT.JJ2)JJ2=M
AOJ J,
; IN LIMITS?
MOVEI A,RINP+=499(J) ;J=J+1
MOVEI 0,(L)
AOJ K, ;K=K+1
MOVEI 1,RINP+=849(K)
MOVEM 0,(1)
ADDI 0,3 ;N(J)=L+3
MOVEM 0,RINP+=499(J)
; NP IS FOR USE IN JUSTIFY ROUTINE
G2: MOVE RY,(R) ;2 IF(RY.EQ.2)GO TO GRST
CAMN RY,[2.0] ;IF(RY.LT.4)GO TO 1
JRST GRST
CAML RY,[=4.0]
CAMLE RY,[=7.0]
JRST GX ;IF(RY.GT.7)GO TO 1
; TWO-ENDED ITEM?
MOVE RZ,-1(R) ;RZ=RN(L)
; WD CNT
KIFIX RY,RY
XCT TBL-4(RY) ; NEXT REPLACES THE ABOVE.
JRST G5
JRST GX
TBL: JRST G4
JRST G5
JRST G6
CAMG RZ,[4.0]
G4: CAMG RZ,[=3.0] ;7 IF(RZ.GT.3)GO TO 5
JRST GX
JRST G5 ;GO TO 1
GRST: MOVE RZ,-1(R) ;FOR 'CENTERED' RESTS
JRST G8
G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
JRST G8
SKIPL 6(R) ;IF(R7)GO TO 8
SKIPN =9(R) ;IF(R10.EQ.0)GO TO 8
JRST G8 ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
SKIPG A,7(R) ;IGNORE P8 IF IT IS 0 OR -
JRST G8
CAMG A,.COMM.+6
CAMGE A,.COMM.+5
JRST G8
CAMLE JJ2,X
MOVE JJ2,X
AOJ J,
; IN LIMITS?
MOVEI 0,=8(L) ;J=J+1
MOVEM 0,RINP+=499(J)
G8: CAML RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
SKIPG A,8(R) ; R9 IF(R9.LE.0)GO TO G5
JRST G5
CAME RY,[2.0] ;IF(RY.EQ.2)GO TO GRST2 (NEW REST CENTERING)
SKIPE 7(R) ; R8 USE R9 IF R9<0 AND (R8≠0 OR R7<0)
JRST GRST2
SKIPL 6(R) ; R7
JRST G5
GRST2: CAMG A,.COMM.+6
CAMGE A,.COMM.+5 ;R4
JRST G5
CAMLE JJ2,X
MOVE JJ2,X
AOJ J, ;J=J+1
; IN LIMITS?
MOVEI 0,=9(L)
MOVEM 0,RINP+=499(J)
G5: CAMN RY,[2.0] ;IF(RY.EQ.2)GO TO 1
JRST GX
MOVE A,5(R)
CAMG A,.COMM.+6
CAMGE A,.COMM.+5 ;R4
JRST GX
CAMLE JJ2,X
MOVE JJ2,X
AOJ J,
; IN LIMITS?
MOVEI 0,6(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
MOVEM 0,RINP+=499(J)
GX: CAMGE X,LIMIT+1 ;1 CONTINUE
;;GX: CAMGE X,PTR+=250 ;1 CONTINUE
AOJA M,G1
MOVEM JJ2,POSI+=8
MOVEM J,KJY+1
MOVEM K,KJY
JRA 16,1(16)
; SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
; DIMENSION NP(1),RN(1)
; COMMON /KJY/ DONT,J
MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
MOVE R,@5(16)
FSBR R,@4(16)
MOVE RY,@3(16)
FSBR RY,@2(16)
FDVR R,RY
; MOVEI L,XRN+=2499 ; DO 1 K=1,J
MOVEI L,@1(16) ; GET NP ARRAY LOC
SETZ K,
MOVE 0,@5(16) ; SET UP R9
;;M1: MOVE X,L ; L=NP(K)
M1: MOVEI R2,@(16) ;RA=RN(L)
ADD R2,(L)
MOVEI RZ,(R2)
MOVE R2,-1(R2)
CAML R2,@2(16) ;IF(OUTLIM(R4,R5,RA))GO TO 1
CAMLE R2,@3(16)
JRST MX
JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
FSBR R2,@2(16)
FMPR R2,R
M2: FADR R2,@4(16) ; RN(L)=R8+RA
MOVEM R2,-1(RZ)
MX: AOJ K, ;1 CONTINUE
CAMGE K,KJY+1
AOJA L,M1
JRA 16,6(16)
;***** COPYIT
;; TITLE COPYIT
; SUBROUTINE COPYIT
; COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
; 1/PTR/PWDS(250),ITEM,LL,I,IX
; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
; 1,(R6,RJQ(4)),(N,RN(2500))
STFCH: 0
SETO 13, ;FLAG FOR STFCH ROUTINE
JRST .+3
COPYIT: 0
SETZ 13, ;MAKE SURE IT'S 0
SETZ 7, ;IM=ITEM
MOVE 15,LIMIT+1 ; AC7 IS K-1
;; MOVE 15,PTR+=250 ; AC7 IS K-1
SOJ 15, ;(ITEM-1)
CP1: JSA 16,RTLINE ;DO 1 K=1,IM
JUMP PTR(7) ;L=PWDS(K)
JUMPL CPY ; IF(RTLINE(L))GO TO 1
JSA 16,OUTLIM ;IF(OUTLIM(L,3))GO TO 1
JUMP PTR(7)
JUMP [3]
JUMPL CPY
MOVE 11,PTR(7) ; NOW L IS AC11
MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
JUMPE 10,CP3
CAME 10,XRN(11)
JRST CPY
CP3: JUMPL 13,STF2 ; SKIP OVER FOR STFCH ROUTINE
KIFIX 12,XRN-1(11) ;M=RN(L)+2
ADDI 12,2
JSA 16,LOOP ;CALL LOOP(0,M,1,I,L,RN)
JUMP [0]
JUMP 12
JUMP [1]
;; JUMP PTR+=252
JUMP LIMIT+3
JUMP 11
JUMP XRN
AOS LIMIT+1 ;ITEM=ITEM+1
;; AOS PTR+=250 ;ITEM=ITEM+1
;; MOVE 13,PTR+=250
MOVE 13,LIMIT+1
MOVE 11,PTR-1(13) ;L=PWDS(ITEM)
STF2: MOVE 14,.COMM.+=8 ;RN(L+2)=R7
CAMG 14,[7.0] ;R7 > 7 = DON'T CHANGE STAFF NUM.
MOVEM 14,XRN+1(11)
JUMPGE 13,CP2
MOVE 0,7
AOJ
CAMGE POSI+=8
MOVEM POSI+=8 ; IF(K.LT.JJ2)JJ2=K
JRST CPY
CP2: CAMGE 13,POSI+=8 ;IF(ITEM.LT.JJ2)JJ2=ITEM
MOVEM 13,POSI+=8
AOJ 12, ;I=I+M+1
ADD 12,LIMIT+3
MOVEM 12,LIMIT+3
MOVEM 12,PTR(13) ;PWDS(ITEM+1)=I
CPY: CAMGE 7,15 ;1 CONTINUE
AOJA 7,CP1
JUMPL 13,.+3
MOVE 7,.COMM.+=8 ;R2=R7
MOVEM 7,.COMM. ;DOES THIS MATTER FOR STFCH}
JRA 16,(16) ;END
;SUBROUTINE STFCH
;INTEGER PWDS
;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
;1/PTR/PWDS(250),ITEM,LL,I,IX
;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
;DO 1 K=1,ITEM
;L=PWDS(K)
;IF(RTLINE(L))GO TO 1
;IF(OUTLIM(L,3))GO TO 1
;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
;C DIDN'T MATCH THE CODE NUM.
;IF(JJ2)JJ2=K
;RN(L+2)=R7
;1 CONTINUE
;END
;SUBROUTINE DELETE
;IMPLICIT INTEGER(A-Q,S-Z)
;COMMON/DL/X22,SAVER,NAME
;COMMON /XRN/RN(4000)
;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(15),R6,DEL,X,JY,K
;COMMON/PTR/PWDS(250),ITEM,L,I,IX
;COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
DELETE: 0 ;EQUIVALENCE (ST2,ST(2))
MOVE 15,LIMIT+3
MOVEM 15,LIMIT+4
;; MOVE 15,PTR+=252
;; MOVEM 15,PTR+=253
MOVE 12,DPY+=4000 ;171 IX=I 15 IS IX
KIFIX 14,XRN-1(12) ;L=RN(MEDIT)+3.0
ADDI 14,3 ;AC14 IS L
; SIZE OF DELETION
SUB 15,14 ;I=IX-L
MOVEM 15,LIMIT+3
;; MOVEM 15,PTR+=252
JSA 16,LOOP ;CALL LOOP(MEDIT,I,1,0,L,RN)
JUMP DPY+=4000
JUMP LIMIT+3
;; JUMP PTR+=252
JUMP [1]
JUMP [0]
JUMP 14
JUMP XRN
MOVE 7,DL ;JY=WDS(X22+1)-WDS(X22)
MOVE 13,DPTR(7)
;; MOVE 13,DPY+=4000(7)
;; SUB 13,DPY+=3999(7) ;JY IS 13, X22 IS 7
SUB 13,DPTR-1(7) ;JY IS 13, X22 IS 7
MOVEI 10,2
ADD 10,DPTR-1(7) ;WDS(X22)+2
MOVE 15,LIMIT+1 ;15 IS ITEM (X)
JSA 16,LOOP ;CALL LOOP(WDS(X22)+2,WDS(X),1,0,JY,ST)
JUMP 10
JUMP DPTR-1(15)
;; JUMP DPY+=3999(15)
JUMP [1]
JUMP [0]
JUMP 13
JUMP DPY
MOVE 12,7 ;K=X22
DELE: MOVE 11,12 ;194 N=K+1
AOJ 11, ;N IS 11 K IS 12
MOVE 2,DPTR(11) ;WDS(N)=WDS(N+1)-JY
SUB 2,13
MOVEM 2,DPTR-1(11)
MOVE 2,PTR-1(11) ;PWDS(K)=PWDS(N)-L
SUB 2,14
MOVEM 2,PTR-1(12)
MOVE 12,11 ;K=N
CAMGE 12,15 ;IF(K.LT.X)GO TO 194
JRST DELE ; ABOVE RESHUFFLES POINTER ARRAYS. X=ITEM+1
SOS LIMIT+1 ;ITEM=ITEM-1
MOVE 2,LIMIT+1
CAMLE 7,LIMIT+1 ;IF(X22.GT.ITEM)X22=ITEM
MOVEM 2,DL
MOVEM 2,.COMM.+2 ;J2=ITEM
SOS LIMIT+1 ;ITEM=ITEM-1
MOVE 2,DPTR-1(2) ;ST2=WDS(J2)
MOVEM 2,DPY+1
JSA 16,DPYNEW ;271 CALL DPYNEW
JRA 16,(16)
;SLEND: 0 ; SUBROUTINE SLEND
; MOVE 8,[8.0] ;INTEGER PWDS
; MOVE 7,SCM+=80 ;C TO FIND END POINTS OF STAVES
; MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
;; 1 DMAX,UMAX,AA,JMAX,X,Y,BB,RNX(1982)
;; 1/SCM/V(78),I,LCNT,STAFF,LIST(200),REND/PTR/PWDS(250),ITEM,LL,IS,IX
; SETZ 5, ;DO 1 K=1,ITEM
;SLN1: MOVE 6,PTR(5) ;L=PWDS(K)
; ;IF(RN(L+1).NE.8)GO TO 1
; CAMN 8,XRN(6) ;C FOUND A STAFF ;IF(RN(L+2).NE.STAFF)GO TO 1
; CAME 7,XRN+1(6) ;C GOT THE RIGHT ONE
; JRST SLN1X ;IF(IT)GO TO 2
; SKIPGE RMOD+=10 ;POS=202
; JRST SLN2 ;C NOW CHECK LEFT SIDE OF STAFF
; MOVSI 15,210624 ;[202.0] ;IF(RN(L).LT.4)RETURN
; CAML 4,XRN-1(6) ;P6 WASN'T MENTIONED - SO IT =200
; JRST SLN3
; ;POS=RN(L+6)+2
; MOVE 15,XRN+5(6) ;IF(POS.EQ.2)POS=202
; FADR 15,[2.0] ;RETURN
; CAMN 15,[2.0] ;2 POS=RN(L+3)-2.3
; MOVSI 15,210624 ;[202.0] ;RETURN
; JRST SLN3 ;1 CONTINUE
;SLN2: MOVE 15,XRN+2(6) ;END
; FSBR 15,[2.3]
;SLN3: MOVEM 15,RMOD+=11
; JRA 16,(16)
;SLN1X: AOS 5
; CAMGE 5,LIMIT+1
; JRST SLN1
; SKIPLE RMOD+=11 ;IF(POS.LE.0)RETURN
; JRST SLN2-2 ;POS=202 (IN CASE THERE IS NO STAFF)
; JRA 16,(16) ;END
;POSIT: 0 ; FUNCTION POSIT(V)
; MOVE 15,@(16) ; COMMON/XRN/RN(4000)
; SKIPGE 15 ; DIMENSION POSNT(0/82)
; MOVNS 15 ; EQUIVALENCE (POSNT,RN(3801))
; 1,(A,RN(3884)),(K,RN(3885))
; KIFIX 14,15 ; IF(V)V=-V
; REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
; JSA 16,AMOD ; K=V
; JUMP 15 ; A=POSNT(K)
; JUMP [1.0] ;POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
; TYPE /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
; MOVE 2,RINP+=851(14) ; END
; FSBR 2,RINP+=850(14)
; FMPR 0,2
; FADR 0,RINP+=850(14)
; JRA 16,1(16)
;NOTAIL: 0 ;FUNCTION NOTAIL(X)
; SETZ ;NOTAIL=0
; MOVM 2,@(16) ;X=ABS(X)
; CAML 2,[0.56] ;IF(X.LT..56.OR.X.EQ..75)RETURN
; CAMN 2,[0.75]
; JRA 16,1(16)
; CAME 2,[0.875] ;IF(X.EQ..875.OR.X.EQ..6)RETURN (8.. OR 10. )
; CAMN 2,[0.6]
; JRA 16,1(16)
; SETO ;NOTAIL=-1
; JRA 16,1(16)
END